home *** CD-ROM | disk | FTP | other *** search
/ LiquidLibrary 2005 September / LiquidLibrary 2005 Sep - Disc 1.iso / pc / Portfolio Browser / Filters / PDF / LIB / gs_lev2.ps < prev    next >
Text File  |  2003-01-03  |  29KB  |  855 lines
  1. %    Copyright (C) 1990, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This software is licensed to a single customer by Artifex Software Inc.
  4. % under the terms of a specific OEM agreement.
  5.  
  6. % $RCSfile$ $Revision$
  7. % Initialization file for Level 2 functions.
  8. % When this is run, systemdict is still writable,
  9. % but (almost) everything defined here goes into level2dict.
  10.  
  11. level2dict begin
  12.  
  13. % ------ System and user parameters ------ %
  14.  
  15. % User parameters must obey save/restore, and must also be maintained
  16. % per-context.  We implement the former, and some of the latter, here
  17. % with PostScript code.  NOTE: our implementation assumes that user
  18. % parameters change only as a result of setuserparams -- that there are
  19. % no user parameters that are ever changed dynamically by the interpreter
  20. % (although the interpreter may adjust the value presented to setuserparams)
  21. %
  22. % There are two types of user parameters: those which are actually
  23. % maintained in the interpreter, and those which exist only at the
  24. % PostScript level.  We maintain the current state of both types in
  25. % a read-only local dictionary named userparams, defined in systemdict.
  26. % In a multi-context system, each context has its own copy of this
  27. % dictionary.  In addition, there is a constant dictionary named
  28. % psuserparams where each key is the name of a user parameter that exists
  29. % only in PostScript and the value is a procedure to check that the value
  30. % is legal: setuserparams uses this for checking the values.
  31. % setuserparams updates userparams explicitly, in addition to setting
  32. % any user parameters in the interpreter; thus we can use userparams
  33. % to reset those parameters after a restore or a context switch.
  34. % NOTE: the name userparams is known to the interpreter, and in fact
  35. % the interpreter creates the userparams dictionary.
  36.  
  37. % Check parameters that are managed at the PostScript level.
  38. /.checkparamtype {        % <newvalue> <type> .checkparamtype <bool>
  39.   exch type eq
  40. } .bind def
  41. /.checksetparams {        % <newdict> <opname> <checkdict>
  42.                 %   .checksetparams <newdict>
  43.   2 index {
  44.         % Stack: newdict opname checkdict key newvalue
  45.     3 copy 3 1 roll .knownget {
  46.       exec not {
  47.     pop pop pop load /typecheck signalerror
  48.       } if
  49.       dup type /stringtype eq {
  50.     dup rcheck not {
  51.       pop pop pop load /invalidaccess signalerror
  52.     } if
  53.       } if
  54.     } {
  55.       pop
  56.     } ifelse pop pop
  57.   } forall pop pop
  58. } .bind def    % not odef, shouldn't reset stacks
  59.  
  60. % currentuser/systemparams creates and returns a dictionary in the
  61. % current VM.  The easiest way to make this work is to copy any composite
  62. % PostScript-level parameters to global VM.  Currently, the only such
  63. % parameters are strings.  In fact, we always copy string parameters,
  64. % so that we can be sure the contents won't be changed.
  65. /.copyparam {            % <value> .copyparam <value'>
  66.   dup type /stringtype eq {
  67.     .currentglobal true .setglobal
  68.     1 index length string exch .setglobal
  69.     copy readonly
  70.   } if
  71. } .bind def
  72.  
  73. % Some user parameters are managed entirely at the PostScript level.
  74. % We take care of that here.
  75. systemdict begin
  76. /psuserparams 40 dict def
  77. /getuserparam {            % <name> getuserparam <value>
  78.   /userparams .systemvar 1 index get exch pop
  79. } odef
  80. % Fill in userparams (created by the interpreter) with current values.
  81. mark .currentuserparams
  82. counttomark 2 idiv {
  83.   userparams 3 1 roll put
  84. } repeat pop
  85. /.definepsuserparam {        % <name> <value> .definepsuserparam -
  86.   psuserparams 3 copy pop
  87.   type cvlit /.checkparamtype cvx 2 packedarray cvx put
  88.   userparams 3 1 roll put
  89. } .bind def
  90. end
  91. /currentuserparams {        % - currentuserparams <dict>
  92.   /userparams .systemvar dup length dict .copydict
  93. } odef
  94. /setuserparams {        % <dict> setuserparams -
  95.     % Check that we will be able to set the PostScript-level
  96.     % user parameters.
  97.   /setuserparams /psuserparams .systemvar .checksetparams
  98.     % Set the C-level user params.  If this succeeds, we know that
  99.     % the password check succeeded.
  100.   dup .setuserparams
  101.     % Now set the PostScript-level params.
  102.     % The interpreter may have adjusted the values of some of the
  103.     % parameters, so we have to read them back.
  104.   dup {
  105.     /userparams .systemvar 2 index known {
  106.       psuserparams 2 index known not {
  107.     pop dup .getuserparam
  108.       } if
  109.       .copyparam
  110.       /userparams .systemvar 3 1 roll .forceput  % userparams is read-only
  111.     } {
  112.       pop pop
  113.     } ifelse
  114.   } forall
  115.     % A context switch might have occurred during the above loop,
  116.     % causing the interpreter-level parameters to be reset.
  117.     % Set them again to the new values.  From here on, we are safe,
  118.     % since a context switch will consult userparams.
  119.   .setuserparams
  120. } .bind odef
  121. % Initialize user parameters managed here.
  122. /JobName () .definepsuserparam
  123.  
  124. % Restore must restore the user parameters.
  125. % (Since userparams is in local VM, save takes care of saving them.)
  126. /restore {        % <save> restore -
  127.   //restore /userparams .systemvar .setuserparams
  128. } .bind odef
  129.  
  130. % The pssystemparams dictionary holds some system parameters that
  131. % are managed entirely at the PostScript level.
  132. systemdict begin
  133. currentdict /pssystemparams known not {
  134.   /pssystemparams 40 dict readonly def
  135. } if
  136. /getsystemparam {        % <name> getsystemparam <value>
  137.   //pssystemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse
  138. } odef
  139. end
  140. /currentsystemparams {        % - currentsystemparams <dict>
  141.   mark .currentsystemparams //pssystemparams { } forall .dicttomark
  142. } odef
  143. /setsystemparams {        % <dict> setsystemparams -
  144.     % Check that we will be able to set the PostScript-level
  145.     % system parameters.
  146.    /setsystemparams //pssystemparams mark exch {
  147.      type cvlit /.checkparamtype cvx 2 packedarray cvx
  148.    } forall .dicttomark .checksetparams
  149.     % Set the C-level system params.  If this succeeds, we know that
  150.     % the password check succeeded.
  151.    dup .setsystemparams
  152.     % Now set the PostScript-level params.  We must copy local strings
  153.     % into global VM.
  154.    dup
  155.     { //pssystemparams 2 index known
  156.        {        % Stack: key newvalue
  157.      .copyparam
  158.      //pssystemparams 3 1 roll .forceput    % pssystemparams is read-only
  159.        }
  160.        { pop pop
  161.        }
  162.       ifelse
  163.     }
  164.    forall pop
  165. } .bind odef
  166.  
  167. % Initialize the passwords.
  168. % NOTE: the names StartJobPassword and SystemParamsPassword are known to
  169. % the interpreter, and must be bound to noaccess strings.
  170. % The length of these strings must be max_password (iutil2.h) + 1.
  171. /StartJobPassword 65 string noaccess def
  172. /SystemParamsPassword 65 string noaccess def
  173.  
  174. % Redefine cache parameter setting to interact properly with userparams.
  175. /setcachelimit {
  176.   mark /MaxFontItem 2 index .dicttomark setuserparams pop
  177. } .bind odef
  178. /setcacheparams {
  179.     % The MaxFontCache parameter is a system parameter, which we might
  180.     % not be able to set.  Fortunately, this doesn't matter, because
  181.     % system parameters don't have to be synchronized between this code
  182.     % and the VM.
  183.   counttomark 1 add copy setcacheparams
  184.   currentcacheparams    % mark size lower upper
  185.     3 -1 roll pop
  186.     /MinFontCompress 3 1 roll
  187.     /MaxFontItem exch
  188.   .dicttomark setuserparams
  189.   cleartomark
  190. } .bind odef
  191.  
  192. % Add bogus user and system parameters to satisfy badly written PostScript
  193. % programs that incorrectly assume the existence of all the parameters
  194. % listed in Appendix C of the Red Book.  Note that some of these may become
  195. % real parameters later: code near the end of gs_init.ps takes care of
  196. % removing any such parameters from ps{user,system}params.
  197.  
  198. % psuserparams
  199.   /MaxFormItem 100000 .definepsuserparam
  200.   /MaxPatternItem 20000 .definepsuserparam
  201.   /MaxScreenItem 48000 .definepsuserparam
  202.   /MaxUPathItem 5000 .definepsuserparam
  203.  
  204. pssystemparams begin
  205.   /CurDisplayList 0 .forcedef
  206.   /CurFormCache 0 .forcedef
  207.   /CurOutlineCache 0 .forcedef
  208.   /CurPatternCache 0 .forcedef
  209.   /CurUPathCache 0 .forcedef
  210.   /CurScreenStorage 0 .forcedef
  211.   /CurSourceList 0 .forcedef
  212.   /DoPrintErrors false .forcedef
  213.   /MaxDisplayList 140000 .forcedef
  214.   /MaxFormCache 100000 .forcedef
  215.   /MaxOutlineCache 65000 .forcedef
  216.   /MaxPatternCache 100000 .forcedef
  217.   /MaxUPathCache 300000 .forcedef
  218.   /MaxScreenStorage 84000 .forcedef
  219.   /MaxSourceList 25000 .forcedef
  220.   /RamSize 4194304 .forcedef
  221. end
  222.  
  223. % Define the procedures for handling comment scanning.  The names
  224. % %ProcessComment and %ProcessDSCComment are known to the interpreter.
  225. % These procedures take the file and comment string and file as operands.
  226. /.checkprocesscomment {
  227.   dup null eq {
  228.     pop true
  229.   } {
  230.     dup xcheck {
  231.       type dup /arraytype eq exch /packedarraytype eq or
  232.     } {
  233.       pop false
  234.     } ifelse
  235.   } ifelse
  236. } .bind def
  237. /ProcessComment null .definepsuserparam
  238. psuserparams /ProcessComment {.checkprocesscomment} put
  239. (%ProcessComment) cvn {
  240.   /ProcessComment getuserparam
  241.   dup null eq { pop pop pop } { exec } ifelse
  242. } bind def
  243. /ProcessDSCComment null .definepsuserparam
  244. psuserparams /ProcessDSCComment {.checkprocesscomment} put
  245. (%ProcessDSCComment) cvn {
  246.   /ProcessDSCComment getuserparam
  247.   dup null eq { pop pop pop } { exec } ifelse
  248. } bind def
  249.  
  250. % ------ Miscellaneous ------ %
  251.  
  252. (<<) cvn            % - << -mark-
  253.   /mark load def
  254. (>>) cvn            % -mark- <key1> <value1> ... >> <dict>
  255.   /.dicttomark load def
  256. /languagelevel 2 def
  257. % When running in Level 2 mode, this interpreter is supposed to be
  258. % compatible with Adobe version 2017.
  259. /version (2017) readonly def
  260.  
  261. % If binary tokens are supported by this interpreter,
  262. % set an appropriate default binary object format.
  263. /setobjectformat where
  264.  { pop
  265.    /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
  266.    /ByteOrder getsystemparam { 1 add } if
  267.    setobjectformat
  268.  } if
  269.  
  270. % Aldus Freehand versions 2.x check for the presence of the
  271. % setcolor operator, and if it is missing, substitute a procedure.
  272. % Unfortunately, the procedure takes different parameters from
  273. % the operator.  As a result, files produced by this application
  274. % cause an error if the setcolor operator is actually defined
  275. % and 'bind' is ever used.  Aldus fixed this bug in Freehand 3.0,
  276. % but there are a lot of files created by the older versions
  277. % still floating around.  Therefore, at Adobe's suggestion,
  278. % we implement the following dreadful hack in the 'where' operator:
  279. %      If the key is /setcolor, and
  280. %        there is a dictionary named FreeHandDict, and
  281. %        currentdict is that dictionary,
  282. %      then "where" consults only that dictionary and not any other
  283. %        dictionaries on the dictionary stack.
  284. .wheredict /setcolor {
  285.   /FreeHandDict .where {
  286.     /FreeHandDict get currentdict eq {
  287.       pop currentdict /setcolor known { currentdict true } { false } ifelse
  288.     } {
  289.       .where
  290.     } ifelse
  291.   } {
  292.     .where
  293.   } ifelse
  294. } bind put
  295.  
  296. % ------ Virtual memory ------ %
  297.  
  298. /currentglobal            % - currentglobal <bool>
  299.   /currentshared load def
  300. /gcheck                % <obj> gcheck <bool>
  301.   /scheck load def
  302. /setglobal            % <bool> setglobal -
  303.   /setshared load def
  304. % We can make the global dictionaries very small, because they auto-expand.
  305. /globaldict currentdict /shareddict .knownget not { 4 dict } if def
  306. /GlobalFontDirectory SharedFontDirectory def
  307.  
  308. % VMReclaim and VMThreshold are user parameters.
  309. /setvmthreshold {        % <int> setvmthreshold -
  310.   mark /VMThreshold 2 index .dicttomark setuserparams pop
  311. } odef
  312. /vmreclaim {            % <int> vmreclaim -
  313.   dup 0 gt {
  314.     .vmreclaim
  315.   } {
  316.     mark /VMReclaim 2 index .dicttomark setuserparams pop
  317.   } ifelse
  318. } odef
  319. -1 setvmthreshold
  320.  
  321. % ------ IODevices ------ %
  322.  
  323. /.getdevparams where {
  324.   pop /currentdevparams {    % <iodevice> currentdevparams <dict>
  325.     .getdevparams .dicttomark
  326.   } odef
  327. } if
  328. /.putdevparams where {
  329.   pop /setdevparams {        % <iodevice> <dict> setdevparams -
  330.     mark 1 index { } forall counttomark 2 add index
  331.     .putdevparams pop pop
  332.   } odef
  333. } if
  334.  
  335. % ------ Job control ------ %
  336.  
  337. serverdict begin
  338.  
  339. % We could protect the job information better, but we aren't attempting
  340. % (currently) to protect ourselves against maliciousness.
  341.  
  342. /.jobsave null def        % top-level save object
  343. /.jobsavelevel 0 def        % save depth of job (0 if .jobsave is null,
  344.                 % 1 otherwise)
  345. /.adminjob true def        % status of current unencapsulated job
  346.  
  347. end        % serverdict
  348.  
  349. % Because there may be objects on the e-stack created since the job save,
  350. % we have to clear the e-stack before doing the end-of-job restore.
  351. % We do this by executing a 2 .stop, which is caught by the 2 .stopped
  352. % in .runexec; we leave on the o-stack a procedure to execute aftewards.
  353. %
  354. %**************** The definition of startjob is not complete yet, since
  355. % it doesn't reset stdin/stdout.
  356. /.startnewjob {            % <exit_bool> <password_level>
  357.                 %   .startnewjob -
  358.     serverdict /.jobsave get dup null eq { pop } { restore } ifelse
  359.     exch {
  360.             % Unencapsulated job
  361.       serverdict /.jobsave null put
  362.       serverdict /.jobsavelevel 0 put
  363.       serverdict /.adminjob 3 -1 roll 1 gt put
  364.         % The Adobe documentation doesn't say what happens to the
  365.         % graphics state stack in this case, but an experiment
  366.         % produced results suggesting that a grestoreall occurs.
  367.       grestoreall
  368.     } {
  369.             % Encapsulated job
  370.       pop
  371.       serverdict /.jobsave save put
  372.       serverdict /.jobsavelevel 1 put
  373.     } ifelse
  374.         % Reset the interpreter state.
  375.   clear cleardictstack
  376.   initgraphics
  377.   false setglobal
  378. } bind def
  379. /.startjob {            % <exit_bool> <password> <finish_proc>
  380.                 %   .startjob <ok_bool>
  381.   vmstatus pop pop serverdict /.jobsavelevel get eq
  382.   2 index .checkpassword 0 gt and {
  383.     exch .checkpassword exch count 3 roll count 3 sub { pop } repeat
  384.     cleardictstack
  385.         % Reset the e-stack back to the 2 .stopped in .runexec,
  386.         % passing the finish_proc to be executed afterwards.
  387.     2 .stop
  388.   } {        % Password check failed
  389.     pop pop pop false
  390.   } ifelse
  391. } odef
  392. /startjob {            % <exit_bool> <password> startjob <ok_bool>
  393.     % This is a hack.  We really need some way to indicate explicitly
  394.     % to the interpreter that we are under control of a job server.
  395.   .userdict /quit /stop load put
  396.   { .startnewjob true } .startjob
  397. } odef
  398.  
  399. systemdict begin
  400. /quit {                % - quit -
  401.   //systemdict begin serverdict /.jobsave get null eq
  402.    { end //quit }
  403.    { /quit load /invalidaccess /signalerror load end exec }
  404.   ifelse
  405. } bind odef
  406. end
  407.  
  408. % We would like to define exitserver as a procedure, using the code
  409. % that the Red Book says is equivalent to it.  However, since startjob
  410. % resets the exec stack, we can't do this, because control would never
  411. % proceed past the call on startjob if the exitserver is successful.
  412. % Instead, we need to construct exitserver out of pieces of startjob.
  413.  
  414. serverdict begin
  415.  
  416. /exitserver {            % <password> exitserver -
  417.   true exch { .startnewjob } .startjob not {
  418.     /exitserver /invalidaccess signalerror
  419.   } if
  420. } bind def
  421.  
  422. end        % serverdict
  423.  
  424. % ------ Compatibility ------ %
  425.  
  426. % In Level 2 mode, the following replace the definitions that gs_statd.ps
  427. % installs in statusdict and serverdict.
  428. % Note that statusdict must be allocated in local VM.
  429. % We don't bother with many of these yet.
  430.  
  431. /.dict1 { exch mark 3 1 roll .dicttomark } bind def
  432.  
  433. currentglobal false setglobal 25 dict exch setglobal begin
  434. currentsystemparams
  435.  
  436. % The following do not depend on the presence of setpagedevice.
  437. /buildtime 1 index /BuildTime get def
  438. /byteorder 1 index /ByteOrder get def
  439. /checkpassword { .checkpassword 0 gt } bind def
  440. dup /DoStartPage known
  441.  { /dostartpage { /DoStartPage getsystemparam } bind def
  442.    /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
  443.  } if
  444. dup /StartupMode known
  445.  { /dosysstart { /StartupMode getsystemparam 0 ne } bind def
  446.    /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
  447.  } if
  448. %****** Setting jobname is supposed to set userparams.JobName, too.
  449. /jobname { /JobName getuserparam } bind def
  450. /jobtimeout { /JobTimeout getuserparam } bind def
  451. /ramsize { /RamSize getsystemparam } bind def
  452. /realformat 1 index /RealFormat get def
  453. dup /PrinterName known
  454.  { /setprintername { /PrinterName .dict1 setsystemparams } bind def
  455.  } if
  456. /printername
  457.  { currentsystemparams /PrinterName .knownget not { () } if exch copy
  458.  } bind def
  459. currentuserparams /WaitTimeout known
  460.  { /waittimeout { /WaitTimeout getuserparam } bind def
  461.  } if
  462.  
  463. % The following do require setpagedevice.
  464. /.setpagedevice where { pop } { (%END PAGEDEVICE) .skipeof } ifelse
  465. /defaulttimeouts
  466.  { currentsystemparams dup
  467.    /JobTimeout .knownget not { 0 } if
  468.    exch /WaitTimeout .knownget not { 0 } if
  469.    currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
  470.  } bind def
  471. /margins
  472.  { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse
  473.  } bind def
  474. /pagemargin
  475.  { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse
  476.  } bind def
  477. /pageparams
  478.  { currentpagedevice
  479.    dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch
  480.    dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll
  481.    /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll
  482.  } bind def
  483. /setdefaulttimeouts
  484.  { exch mark /ManualFeedTimeout 3 -1 roll
  485.    /Policies mark /ManualFeedTimeout 1 .dicttomark
  486.    .dicttomark setpagedevice
  487.    /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
  488.  } bind def
  489. /.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
  490. /setduplexmode { /Duplex .dict1 setpagedevice } bind def
  491. /setmargins
  492.  { exch 2 array astore /Margins .dict1 setpagedevice
  493.  } bind def
  494. /setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def
  495. /setpageparams
  496.  { mark /PageSize 6 -2 roll
  497.    4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore
  498.    /Orientation 5 -1 roll ORIENT1 { 1 xor } if
  499.    /PageOffset counttomark 2 add -1 roll 0 2 array astore
  500.    .dicttomark setpagedevice
  501.  } bind def
  502. /setresolution
  503.  { dup 2 array astore /HWResolution .dict1 setpagedevice
  504.  } bind def
  505. %END PAGEDEVICE
  506.  
  507. % The following are not implemented yet.
  508. %manualfeed
  509. %manualfeedtimeout
  510. %pagecount
  511. %pagestackorder
  512. %setpagestackorder
  513.  
  514. pop        % currentsystemparams
  515.  
  516. % Flag the current dictionary so it will be swapped when we
  517. % change language levels.  (See zmisc2.c for more information.)
  518. /statusdict currentdict def
  519.  
  520. currentdict end
  521. /statusdict exch .forcedef    % statusdict is local, systemdict is global
  522.  
  523. % The following compatibility operators are in systemdict.  They are
  524. % defined here, rather than in gs_init.ps, because they require the
  525. % resource machinery.
  526.  
  527. /devforall {        % <pattern> <proc> <scratch> devforall -
  528.   exch {
  529.     1 index currentdevparams
  530.     /Type .knownget { /FileSystem eq } { false } ifelse
  531.     { exec } { pop pop } ifelse
  532.   } /exec load 3 packedarray cvx exch
  533.   (*) 3 1 roll ppstack flush /IODevice resourceforall
  534. } odef
  535. /devstatus {        % <(%disk*%)> devstatus <searchable> <writable>
  536.             %   <hasNames> <mounted> <removable> <searchOrder>
  537.             %   <freePages> <size> true
  538.             % <string> devstatus false
  539.   dup length 5 ge {
  540.     dup 0 5 getinterval (%disk) eq {
  541.       dup /IODevice resourcestatus {
  542.     pop pop dup currentdevparams
  543.     dup /Searchable get
  544.     exch dup /Writable get
  545.     exch dup /HasNames get
  546.     exch dup /Mounted get
  547.     exch dup /Removable get
  548.     exch dup /SearchOrder get
  549.     exch dup /Free get
  550.     exch /LogicalSize get
  551.     9 -1 roll pop true
  552.       } {
  553.     pop false
  554.       } ifelse
  555.     } {
  556.       pop false
  557.     } ifelse
  558.   } {
  559.     pop false
  560.   } ifelse
  561. } odef
  562.  
  563. % ------ Color spaces ------ %
  564.  
  565. % Attempt to convert a tint transformation procedure to a Function.
  566. % The current color space defines the number of output values.
  567. /.converttinttransform {    % [.. .. .. proc ] <m>
  568.                 %   .converttinttransform [.. .. .. proc']
  569.   .currentglobal 2 index gcheck .setglobal
  570.   4 dict
  571.     dup /FunctionType 4 put
  572.     dup /Function 5 index 3 get put
  573.         % Stack: orig m global func
  574.     dup /Domain [ 6 -1 roll {0 1} repeat ] put
  575.     dup /Range [
  576.       mark currentcolor counttomark
  577.       dup 2 add 1 roll cleartomark    % # of components in alternate space
  578.     {0 1} repeat ] put
  579.   { .buildfunction } .internalstopped {
  580.     pop .setglobal
  581.   } {
  582.         % Stack: orig global func
  583.     2 index 4 array copy dup 3 4 -1 roll put
  584.     exch .setglobal exch pop
  585.   } ifelse
  586. } bind def
  587.  
  588. % Define the setcolorspace procedures:
  589. %    <colorspace> proc <colorspace'|null>
  590. % We have to define the dictionary first, so it can be bound into the
  591. % implementation procedure, but we can't populate it until the procedure
  592. % has been defined, so that the procedure can get bound into recursive calls.
  593. /colorspacedict 20 dict def
  594.  
  595. /.devcs [
  596.   /DeviceGray /DeviceRGB /DeviceCMYK /DevicePixel
  597. ] readonly def
  598. /currentcolorspace {        % - currentcolorspace <array>
  599.   .currentcolorspace dup type /integertype eq {
  600.     //.devcs exch 1 getinterval
  601.   } if
  602. } odef
  603. currentdict /.devcs .undef
  604.  
  605. /setcolorspace {        % <name|array> setcolorspace -
  606.   dup dup dup type /nametype ne { 0 get } if
  607.   //colorspacedict exch get exec
  608.   dup null eq { pop } { .setcolorspace } ifelse pop
  609. } odef
  610.  
  611. colorspacedict
  612.   dup /DeviceGray { pop 0 setgray null } bind put
  613.   dup /DeviceRGB { pop 0 0 0 setrgbcolor null } bind put
  614.   /setcmykcolor where
  615.    { pop dup /DeviceCMYK { pop 0 0 0 1 setcmykcolor null } bind put
  616.    } if
  617.   /.setcieaspace where
  618.    { pop dup /CIEBasedA { NOCIE { pop 0 setgray null } { dup 1 get .setcieaspace } ifelse } bind put
  619.    } if
  620.   /.setcieabcspace where
  621.    { pop dup /CIEBasedABC { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setcieabcspace } ifelse } bind put
  622.    } if
  623.   /.setciedefspace where
  624.    { pop dup /CIEBasedDEF { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setciedefspace } ifelse } bind put
  625.    } if
  626.   /.setciedefgspace where
  627.    { pop dup /CIEBasedDEFG { NOCIE { pop 0 0 0 1 setcmykcolor null } { dup 1 get .setciedefgspace } ifelse } bind put
  628.    } if
  629.   /.setseparationspace where
  630.    { pop dup /Separation { dup 2 get setcolorspace dup 1 .converttinttransform .setseparationspace } bind put
  631.    } if
  632.   /.setindexedspace where
  633.    { pop dup /Indexed { dup 1 get setcolorspace dup .setindexedspace } bind put
  634.    } if
  635.   /.nullpatternspace [/Pattern] readonly def
  636.   /.setpatternspace where
  637.    { pop dup /Pattern
  638.       { dup type /nametype eq { pop //.nullpatternspace } if
  639.     dup length 1 gt { dup 1 get setcolorspace } if
  640.         dup .setpatternspace
  641.       } bind put
  642.    } if
  643.     % If DeviceN space is included, gs_ll3.ps registers it.
  644.   /.setdevicepixelspace where
  645.    { pop dup /DevicePixel { dup .setdevicepixelspace } bind put
  646.    } if
  647.   currentdict /.nullpatternspace .undef
  648. pop
  649.  
  650. % ------ CIE color rendering ------ %
  651.  
  652. % Define findcolorrendering and a default ColorRendering ProcSet.
  653.  
  654. /findcolorrendering {        % <intentname> findcolorrendering
  655.                 %   <crdname> <found>
  656.   /ColorRendering /ProcSet findresource
  657.   1 index .namestring (.) concatstrings
  658.   1 index /GetPageDeviceName get exec .namestring (.) concatstrings
  659.   2 index /GetHalftoneName get exec .namestring
  660.   concatstrings concatstrings
  661.   dup /ColorRendering resourcestatus {
  662.     pop pop exch pop exch pop true
  663.   } {
  664.     pop /GetSubstituteCRD get exec false
  665.   } ifelse
  666. } odef
  667.  
  668. 5 dict dup begin
  669.  
  670. /GetPageDeviceName {        % - GetPageDeviceName <name>
  671.   currentpagedevice dup /PageDeviceName .knownget {
  672.     exch pop dup null eq { pop /none } if
  673.   } {
  674.     pop /none
  675.   } ifelse
  676. } bind def
  677.  
  678. /GetHalftoneName {        % - GetHalftoneName <name>
  679.   currenthalftone /HalftoneName .knownget not { /none } if
  680. } bind def
  681.  
  682. /GetSubstituteCRD {        % <intentname> GetSubstituteCRD <crdname>
  683.   pop /DefaultColorRendering
  684. } bind def
  685.  
  686. end
  687. % The resource machinery hasn't been activated, so just save the ProcSet
  688. % and let .fixresources finish the installation process.
  689. /ColorRendering exch def
  690.  
  691. % Define setcolorrendering.
  692.  
  693. /.colorrenderingtypes 5 dict def
  694.  
  695. /setcolorrendering {        % <crd> setcolorrendering -
  696.   dup /ColorRenderingType get //.colorrenderingtypes exch get exec
  697. } odef
  698.  
  699. /.setcolorrendering1 where { pop } { (%END CRD) .skipeof } ifelse
  700.  
  701. .colorrenderingtypes 1 {
  702.   dup .buildcolorrendering1 .setcolorrendering1
  703. } .bind put
  704.  
  705. % Note: the value 101 in the next line must be the same as the value of
  706. % GX_DEVICE_CRD1_TYPE in gscrdp.h.
  707. .colorrenderingtypes 101 {
  708.   dup .builddevicecolorrendering1 .setdevicecolorrendering1
  709. } .bind put
  710.  
  711. % Initialize the default CIE rendering dictionary.
  712. % The most common CIE files seem to assume the "calibrated RGB color space"
  713. % described on p. 189 of the PostScript Language Reference Manual,
  714. % 2nd Edition; we simply invert this transformation back to RGB.
  715. mark
  716.    /ColorRenderingType 1
  717. % We must make RangePQR and RangeLMN large enough so that values computed by
  718. % the assumed encoding MatrixLMN don't get clamped.
  719.    /RangePQR [0 0.9505 0 1 0 1.0890] readonly
  720. % This TransformPQR implements a relative colorimetric intent by scaling
  721. % the XYZ values relative to the white and black points.
  722.    /TransformPQR
  723.      [ { 5 1 roll                    % p Ws Bs Wd Bd
  724.          4 {3 get 5 1 roll} repeat   % ws bs wd bd p 
  725.          3 index sub                 % ws bs wd bd p-bs 
  726.          1 index                     % ws bs wd bd p-bs bd
  727.          6 2 roll                    % p-bs bd ws bs wd bd 
  728.          sub                         % p-bs bd ws bs wd-bd 
  729.          5 1 roll                    % wd-bd p-bs bd ws bs  
  730.          sub                         % wd-bd p-bs bd ws-bs  
  731.          4 2 roll                    % bd ws-bs wd-bd p-bs 
  732.          mul                         % bd ws-bs (wd-bd)*(p-bs)
  733.          exch div add                % bd + (wd-bd)*(p-bs)/(ws-bs)
  734.        } bind
  735.        { 5 1 roll
  736.          4 {4 get 5 1 roll} repeat
  737.          3 index sub 1 index 6 2 roll sub 5 1 roll
  738.          sub 4 2 roll mul exch div add
  739.        } bind
  740.        { 5 1 roll
  741.          4 {5 get 5 1 roll} repeat
  742.          3 index sub 1 index 6 2 roll sub 5 1 roll
  743.          sub 4 2 roll mul exch div add
  744.        } bind
  745.      ] readonly
  746.    /RangeLMN [0 0.9505 0 1 0 1.0890] readonly
  747.    /MatrixABC
  748.     [ 3.24063 -0.96893  0.05571
  749.      -1.53721  1.87576 -0.20402
  750.      -0.49863  0.04152  1.05700
  751.     ] readonly
  752.    /EncodeABC [ {0 .max 0.45 exp} bind dup dup] readonly
  753.    /WhitePoint [0.9505 1 1.0890] readonly
  754.     % Some Genoa tests seem to require the presence of BlackPoint.
  755.    /BlackPoint [0 0 0] readonly
  756. .dicttomark setcolorrendering
  757.  
  758. %END CRD
  759.  
  760. % Initialize a CIEBased color space for sRGB.
  761. /CIEsRGB [ /CIEBasedABC
  762.   mark
  763.     /DecodeLMN [ {
  764.       dup 0.03928 le { 12.92321 div } { 0.055 add 1.055 div 2.4 exp } ifelse
  765.     } bind dup dup ] readonly
  766.     /MatrixLMN [
  767.       0.412457 0.212673 0.019334
  768.       0.357576 0.715152 0.119192
  769.       0.180437 0.072175 0.950301
  770.     ] readonly
  771.     /WhitePoint [0.9505 1.0 1.0890] readonly
  772.   .dicttomark readonly
  773. ] readonly def
  774.  
  775. % ------ Painting ------ %
  776.  
  777. % A straightforward definition of execform that doesn't actually
  778. % do any caching.
  779. /.execform1 {
  780.     % This is a separate operator so that the stacks will be restored
  781.     % properly if an error occurs.
  782.   dup /Matrix get concat
  783.   dup /BBox get aload pop
  784.   exch 3 index sub exch 2 index sub rectclip
  785.   dup /PaintProc get
  786.   1 index /Implementation known not {
  787.     1 index dup /Implementation null .forceput readonly pop
  788.   } if
  789.   exec
  790. } .bind odef    % must bind .forceput
  791.  
  792. /.formtypes 5 dict
  793.   dup 1 /.execform1 load put
  794. def
  795.  
  796. /execform {            % <form> execform -
  797.   gsave {
  798.     dup /FormType get //.formtypes exch get exec
  799.   } stopped grestore { stop } if
  800. } odef
  801.  
  802. /.patterntypes 5 dict
  803.   dup 1 /.buildpattern1 load put
  804. def
  805.  
  806. /makepattern {            % <proto_dict> <matrix> makepattern <pattern>
  807.   //.patterntypes 2 index /PatternType get get
  808.   .currentglobal false .setglobal exch
  809.         % Stack: proto matrix global buildproc
  810.   3 index dup length 1 add dict .copydict
  811.   3 index 3 -1 roll exec 3 -1 roll .setglobal
  812.   1 index /Implementation 3 -1 roll put
  813.   readonly exch pop exch pop
  814. } odef
  815.  
  816. /setpattern {            % [<comp1> ...] <pattern> setpattern -
  817.   currentcolorspace 0 get /Pattern ne {
  818.     [ /Pattern currentcolorspace ] setcolorspace
  819.   } if setcolor
  820. } odef
  821.  
  822. % Extend image and imagemask to accept dictionaries.
  823. % We must create .imagetypes and .imagemasktypes outside level2dict,
  824. % and leave some extra space because we're still in Level 1 mode.
  825. systemdict begin
  826. /.imagetypes 5 dict
  827.   dup 1 /.image1 load put
  828. def
  829. /.imagemasktypes 5 dict
  830.   dup 1 /.imagemask1 load put
  831. def
  832. end
  833.  
  834. /.image /image load def
  835. /image {
  836.   dup type /dicttype eq {
  837.     dup /ImageType get //.imagetypes exch get exec
  838.   } {
  839.     //.image
  840.   } ifelse
  841. } odef
  842. currentdict /.image undef
  843.  
  844. /.imagemask /imagemask load def
  845. /imagemask {
  846.   dup type /dicttype eq {
  847.     dup /ImageType get //.imagemasktypes exch get exec
  848.   } {
  849.     //.imagemask
  850.   } ifelse
  851. } odef
  852. currentdict /.imagemask undef
  853.  
  854. end                % level2dict
  855.